Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/text_utl/text2/text2.frm

Visual Basic Form | 1996-01-20 | 11.9 KB | 318 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form1"
   ClientHeight    =   6120
   ClientLeft      =   1515
   ClientTop       =   1995
   ClientWidth     =   8535
   ClipControls    =   0   'False
   FontBold        =   -1  'True
   FontItalic      =   0   'False
   FontName        =   "Times New Roman"
   FontSize        =   9.75
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   Height          =   6900
   Left            =   1410
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   408
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   569
   Top             =   1320
   Width           =   8745
   Begin HScrollBar sc2
      Height          =   255
      LargeChange     =   20
      Left            =   300
      Max             =   240
      SmallChange     =   6
      TabIndex        =   2
      Top             =   5580
      Width           =   7665
   End
   Begin CommonDialog CMDialog1
      Left            =   75
      Top             =   -120
   End
   Begin VScrollBar sc
      Height          =   5310
      LargeChange     =   322
      Left            =   7950
      TabIndex        =   0
      Top             =   285
      Width           =   255
   End
   Begin PictureBox p
      BackColor       =   &H00FFFFFF&
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Times New Roman"
      FontSize        =   10.5
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   5310
      Left            =   300
      ScaleHeight     =   352
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   509
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   285
      Width           =   7665
   End
   Begin Shape box
      BorderColor     =   &H00000000&
      FillColor       =   &H00800000&
      FillStyle       =   0  'Solid
      Height          =   240
      Left            =   7950
      Top             =   5595
      Width           =   255
   End
   Begin Menu mnuFile
      Caption         =   "File"
      Begin Menu mnuOpen
         Caption         =   "Open"
      End
      Begin Menu mnuFont
         Caption         =   "Font"
      End
   End
Option Explicit
Dim lArray() As String * 100  ' you can make the line width anything you want I made it 100 characters wide
Dim linenum%, texwidth%, h%, paint%, oldx%, oldy%, opening%, fileopen%
Declare Function TextOut Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal lpString As String, ByVal nCount As Integer) As Integer
Declare Sub ScrollWindow Lib "User" (ByVal hWnd As Integer, ByVal XAmount As Integer, ByVal YAmount As Integer, ByVal lpRect As Long, ByVal lpClipRect As Long)
Declare Sub UpdateWindow Lib "User" (ByVal hWnd As Integer)
Declare Function GetSysColor Lib "User" (ByVal nIndex%) As Long
Const COLOR_SCROLLBAR = 0
Sub Center (frm As Form)
   frm.Top = (Screen.Height - frm.Height) \ 2
   frm.Left = (Screen.Width - frm.Width) \ 2
End Sub
Sub ChangeFont ()
Dim i%
 p.Cls
    h = p.TextHeight(lArray(1))
    sc2.Max = max(0, (p.TextWidth("a") * texwidth) - (p.Width \ 2))
    If sc2.Value > sc2.Max Then sc2.Value = sc2.Max: oldy = sc2.Value
    sc.LargeChange = Format(p.Height / h, "0")  'set to the number of lines in one page
    sc.Max = max(0, linenum - (sc.LargeChange - 2)) 'set the max to the number of lines - one page - one line
    sc.LargeChange = min(linenum, Format(p.Height / h, "0")) ' if number of lines are less than a page
    If sc.Value > sc.Max Then sc.Value = sc.Max   ' make sure the value isn't past max when you change the font
    oldx = sc.Value
 opening = False
End Sub
Sub Form_Load ()
Dim oneline$, i%, Color&
Center Me
Color = GetSysColor(COLOR_SCROLLBAR)
box.FillColor = Color       ' set the box the same color as your scroll bars
End Sub
Sub Form_Paint ()
Dim Color&
  paint = True    ' repaint the whole picture box only when the form repaints not when the picture box repaints
  p.Refresh       ' or otherwise the picture repaints when you scroll which slows down the scrolling
  Color = GetSysColor(COLOR_SCROLLBAR)  'this is only if you change the color of the scroll bars while the program is running
  box.FillColor = Color                 'so the box is the same color as the scroll bars
End Sub
Function max% (a%, b%)
  If a >= b Then max = a
  If b > a Then max = b
End Function
Function min% (a%, b%)
If a <= b Then min = a
If b < a Then min = b
End Function
Sub mnuFont_Click ()
On Error Resume Next
CMDialog1.CancelError = True
CMDialog1.Flags = &H103&
If Int(p.FontSize) < p.FontSize Then CMDialog1.FontSize = Int(p.FontSize) + 1:  Else CMDialog1.FontSize = p.FontSize  ' if the font in the picture box is in between numbers round up
CMDialog1.FontName = p.FontName
CMDialog1.FontBold = p.FontBold
CMDialog1.Color = p.ForeColor
CMDialog1.FontItalic = p.FontItalic
CMDialog1.Action = 4
If Err = 0 Then 'reset the picture box font attributes
   p.FontSize = CMDialog1.FontSize
   p.FontName = CMDialog1.FontName
   p.FontBold = CMDialog1.FontBold
   p.ForeColor = CMDialog1.Color
   p.FontItalic = CMDialog1.FontItalic
   opening = True
    ChangeFont
End If
End Sub
Sub mnuOpen_Click ()
Dim fname$
On Error Resume Next
CMDialog1.CancelError = True
CMDialog1.DefaultExt = "TXT"
CMDialog1.Filter = "Text Files (.txt)| *.txt|All Files (*.*)| *.*"
CMDialog1.DialogTitle = "Open File"
CMDialog1.Action = 1
If Err = 0 Then
   opening = True
   fileopen = True
   fname = CMDialog1.Filename
   OpenFile fname
End If
End Sub
'this function paints two lines of text on the picture starting from how many lines
'there are in a page - 2 to how many lines in a page. The sc.LargeChange has been
'set to how many lines in a page
Sub NextLine ()
Dim d%, i%, c%, pos%
c = sc.Value   ' set c to the value of the scroll bar so you know what line you are on
p.CurrentY = (sc.LargeChange - 2) * h  ' how many lines in a page - 2 * the height of one line
For i = c + (sc.LargeChange - 2) To c + sc.LargeChange ' set I so it is the bottom two lines on the page
  p.CurrentX = -sc2.Value       ' make current x  the value of the horizontal scroll bar so if you have scrolled left then it starts in the right place
  p.Print lArray(i)
End Sub
'this function opens a file, counts the number of lines, sets the line height for the size
'font your using at the time,gets the widest line so you can set the width, sets both scroll bars max,
'redims the line array to the size of the file, fills the array with the lines, and then prints the first page
Sub OpenFile (fname$)
Dim oneline$, i%, w%
 p.Cls
sc.Value = 0
oldx = sc.Value
sc2.Value = 0
oldy = sc2.Value
texwidth = 0
Open fname For Input As #1
linenum = 0
Do While Not EOF(1)
  Line Input #1, oneline
   w = Len(oneline)
   If w >= texwidth Then texwidth = w
   linenum = linenum + 1     ' get the number of lines
sc2.Max = max(0, (p.TextWidth("a") * texwidth) - (p.Width \ 2))
ReDim lArray(linenum + 2)    'set to two more than number of lines so no errors when scrolling
Seek #1, 1
  Line Input #1, oneline
  h = p.TextHeight(oneline)  ' get the height of one line
  sc.SmallChange = 1              ' set to one line
  sc.LargeChange = Format(p.Height / h, "0")    'set to the number of lines in one page
  sc.Max = max(0, linenum - (sc.LargeChange - 2))   'set the max to the number of lines - one page - one line
  sc.LargeChange = min(linenum, Format(p.Height / h, "0"))  ' if number of lines are less than a page
 lArray(0) = ""    ' for a margin on the top
Seek #1, 1
For i = 1 To linenum
  Line Input #1, oneline
  lArray(i) = "     " & oneline  ' fill line array with each line of text I've added a margin on the left for looks
For i = linenum + 1 To linenum + 2
  lArray(i) = ""  ' fill last two with empty strings
Close #1
opening = False
End Sub
Sub p_Paint ()
If paint Then prn: paint = False   ' the form is repainting
End Sub
' this function just prints the previous line at the top of the page
Sub PrevLine ()
Dim d%, i%, c%, pos%
c = sc.Value
p.CurrentX = -sc2.Value
p.CurrentY = 0
For i = c To c
  p.Print lArray(i)
End Sub
' this function paints the whole page of text by which ever page you are on
Sub prn ()
If Not fileopen Then Exit Sub
Dim d%, i%, c%
c = sc.Value
p.CurrentY = 0
For i = c To c + sc.LargeChange    ' set to one page
  p.CurrentX = -sc2.Value          ' set to the value of the horizontal scroll bar
  p.Print lArray(i)
End Sub
Sub sc_Change ()
If Not fileopen Or opening Then Exit Sub  ' don't want to do anything if there is no file loaded or are loading a file

     If oldx < sc.Value And oldx + 1 = sc.Value Then  ' if just scrolling down one line
        ScrollWindow p.hWnd, 0, -((sc.Value - oldx) * h), 0, 0  ' if scrolling down, negative values
        UpdateWindow p.hWnd      ' force an update or you can't print on the scrolled area right away
        NextLine
     End If

     If oldx > sc.Value And oldx - 1 = sc.Value Then    ' if just scrolling up one line
        ScrollWindow p.hWnd, 0, ((oldx - sc.Value) * h), 0, 0  ' if scrolling up, positive values
        UpdateWindow p.hWnd      ' force an update or you can't print on the scrolled area right away
        PrevLine
     End If

     If oldx < sc.Value And oldx + 1 < sc.Value Then   ' if scrolling down a page
        ScrollWindow p.hWnd, 0, -((sc.Value - oldx) * h), 0, 0
        UpdateWindow p.hWnd     ' force an update or you can't print on the scrolled area right away
        prn
     End If

     If oldx > sc.Value And oldx - 1 > sc.Value Then   'if scrolling up a page
        ScrollWindow p.hWnd, 0, ((oldx - sc.Value) * h), 0, 0
        UpdateWindow p.hWnd     ' force an update or you can't print on the scrolled area right away
        prn
     End If
     oldx = sc.Value
End Sub
Sub sc_Scroll ()
If Not fileopen Then Exit Sub
     On Error GoTo errorhandler  ' I was getting a error on large files if I was using
     If oldx < sc.Value Then     ' the scroll thumb and the mouse pointer went off the scroll bar this fixed it
        ScrollWindow p.hWnd, 0, -((sc.Value - oldx) * h), 0, 0
        UpdateWindow p.hWnd
        prn                   ' I had to print a whole page at a time because if I tried to print one
        oldx = sc.Value       ' line at a time it wouldn't keep up with the scroll bar and the print would get screwed up
     End If

     If oldx > sc.Value Then
        ScrollWindow p.hWnd, 0, ((oldx - sc.Value) * h), 0, 0
        UpdateWindow p.hWnd
        prn
        oldx = sc.Value
     End If
Exit Sub
errorhandler:
oldx = sc.Value
p.Cls
Exit Sub
Resume Next
End Sub
Sub sc2_Change ()
If Not fileopen Or opening Then Exit Sub ' don't want to do anything if there is no file loaded or are loading a file

     If oldy < sc2.Value Then
        ScrollWindow p.hWnd, -(sc2.Value - oldy), 0, 0, 0 'if scrolling to the left, negative values
        UpdateWindow p.hWnd
        prn
     End If

     If oldy > sc2.Value Then
        ScrollWindow p.hWnd, (oldy - sc2.Value), 0, 0, 0 'if scrolling to the right, positive values
        UpdateWindow p.hWnd
        prn
     End If
   oldy = sc2.Value
End Sub
Sub sc2_Scroll ()
If Not fileopen Then Exit Sub  ' don't want to do anything if there is no file loaded

     If oldy < sc2.Value Then
        ScrollWindow p.hWnd, -(sc2.Value - oldy), 0, 0, 0
        UpdateWindow p.hWnd
        prn
     End If

     If oldy > sc2.Value Then
        ScrollWindow p.hWnd, (oldy - sc2.Value), 0, 0, 0
        UpdateWindow p.hWnd
        prn
     End If
   oldy = sc2.Value
End Sub